home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib16.dsk / SORT AND PRINT FOOD LIST.bas < prev    next >
BASIC Source File  |  2023-02-26  |  3KB  |  85 lines
  1. 1  REM  **********************
  2. 2  REM  *   SORT AND PRINT   *
  3. 3  REM  * BY D.R. PENDERGAST *
  4. 4  REM  * COPYRIGHT (C) 1984 *
  5. 5  REM  * BY MICROSPARC, INC *
  6. 6  REM  * LINCOLN, MA. 01773 *
  7. 7  REM  **********************
  8. 100  REM  **SORT AND PRINT
  9. 102 D$ =  CHR$(4):BC$ =  CHR$(2):G$ =  CHR$(7): GOTO 12000
  10. 104  REM  **SUBROUTINES BELOW **
  11. 275  REM  **OPEN FILES TO READ**
  12. 280  PRINT D$"OPEN ";FILE$",L";RL
  13. 285  PRINT D$"READ";FILE$",R";RX
  14. 290  RETURN 
  15. 314  REM  **SUBROUTINES ABOVE **
  16. 320  REM  **READ RECORD AND FIELD LENGTH DATA. NOTE HIDDEN CTRL B ADDED TO FILE NAME**
  17. 325  PRINT D$"OPEN";FILE$ +BC$
  18. 330  PRINT D$"READ";FILE$ +BC$
  19. 335  INPUT NF: INPUT RL: DIM T$(2 *NF),TV(NF),P$(NF)
  20. 340  FOR K = 1 TO NF: INPUT T$(K): INPUT TV(K): NEXT K
  21. 345  PRINT D$"CLOSE"FILE$ +BC$
  22. 350  RETURN 
  23. 355  REM  **OPEN FILES TO READ**
  24. 360  PRINT D$"OPEN ";FILE$",L";RL
  25. 365  PRINT D$"READ";FILE$",R0"
  26. 370  RETURN 
  27. 375  REM  **PRINT PAGE HEADING**
  28. 380  PRINT "NO.";: HTAB 12: PRINT "FOOD";: HTAB 27: PRINT "NO.";: POKE 36,39: PRINT "FOOD";: POKE 36,54: PRINT "NO.";: POKE 36,66: PRINT "FOOD"
  29. 385  PRINT 
  30. 390 PP = PP +1:BL = 0
  31. 395  RETURN 
  32. 400  REM **PRINTER ON**
  33. 405  HOME : PRINT : PRINT "ENTER IN PRINTER SLOT #";G$: INPUT SLOT
  34. 425  PRINT D$"PR#";SLOT: PRINT  CHR$(9);"80N"
  35. 430  RETURN 
  36. 435  REM **PRINT FOOD DATA LINES**
  37. 440  PRINT RX(1);: HTAB 5: PRINT P$(1);: HTAB 27: PRINT RX(2);: HTAB 31: PRINT P$(2);: POKE 36,54: PRINT RX(3);: POKE 36,58: PRINT P$(3)
  38. 445  RETURN 
  39. 1200  REM **SORT ROUTINE**
  40. 1205  DIM SRT$(REC),SO(REC)
  41. 1210 SF = 1:S1 = 1
  42. 1215  HOME : VTAB 10: HTAB 16: FLASH : PRINT "SORTING": NORMAL : VTAB 20: PRINT "** COPYRIGHT 1984 BY MICROSPARC, INC. **": VTAB 10: HTAB 23
  43. 1220  PRINT D$"OPEN"FILE$",L";RL
  44. 1225  FOR K = 1 TO REC:RX = K: GOSUB 285: IF SF = 1  THEN 1235
  45. 1230  FOR L = 1 TO SF -1: INPUT Z$: NEXT L
  46. 1235  INPUT SRT$(K):SO(K) = K: NEXT K
  47. 1240  PRINT D$"CLOSE"FILE$
  48. 1245 M = 1
  49. 1250 M = 3 *M +1: IF M <REC  THEN 1250
  50. 1255 M = (M -1)/3: IF M <1  THEN 1275
  51. 1260  FOR J = M +1 TO REC:LL = J -M:SS$ = SRT$(J):S = SO(J)
  52. 1265  IF S1 = (SRT$(LL) >SS$)  THEN SRT$(LL +M) = SRT$(LL):SO(LL +M) = SO(LL):LL = LL -M: IF LL >0  THEN 1265
  53. 1270 SRT$(LL +M) = SS$:SO(LL +M) = S: NEXT J: GOTO 1255
  54. 1275  REM  SORTED LIST COMPLETE
  55. 1280  RETURN 
  56. 1290  REM  **SUBROUTINES ABOVE**
  57. 2050  GOSUB 1200
  58. 12000  TEXT : REM  *PRINT USER FOOD LIST*
  59. 12010  HOME :FILE$ = "FOOD": GOSUB 320:RX = 0: GOSUB 275: INPUT REC
  60. 12020  PRINT D$"CLOSE";FILES$
  61. 12030  TEXT : HOME 
  62. 12050  GOSUB 1205
  63. 12060  TEXT : HOME : VTAB 10: HTAB 5: PRINT "MEMORY REMAINING = ": VTAB 10: HTAB 24: PRINT  FRE(8);: PRINT " BYTES": FOR K = 1 TO 2000: NEXT K
  64. 12070  GOSUB 400
  65. 12080 PP = 1:SP = 1:BL = 1
  66. 12090  FOR K = 1 TO 6: PRINT : NEXT K
  67. 12100  GOSUB 375
  68. 12110 BL = 1
  69. 12120  PRINT D$;"OPEN";FILE$",L";RL
  70. 12130 K4 = REC/3:K5 =  INT(REC/3): IF (K5 <K4)  THEN K4 = K5 +1
  71. 12140  FOR K1 = 1 TO K4
  72. 12150  FOR K2 = 1 TO 3:K3 = ((3 *(K1 -1) +K2)): IF (K3 >REC)  THEN  GOTO 12180
  73. 12160 RX(K2) = SO(K3)
  74. 12170  PRINT D$;"READ";FILE$",R";RX(K2): INPUT P$(K2)
  75. 12180  NEXT K2
  76. 12190  GOSUB 435
  77. 12200  FOR K2 = 1 TO 3:P$(K2) = " ": NEXT K2
  78. 12210  IF SP = 5  THEN  PRINT :SP = 0
  79. 12220  IF BL = 40  THEN  PRINT : POKE 36,59: PRINT "CONTINUED NEXT PAGE": FOR K = 1 TO 14: PRINT : NEXT K: GOSUB 375
  80. 12230 SP = SP +1:BL = BL +1
  81. 12240  NEXT K1
  82. 12250  PRINT D$;"CLOSE";FILE$
  83. 12260  PRINT D$;"PR#0"
  84. 12270  HOME : VTAB 10: FLASH : PRINT "LOADING 'NIBBLE DINER'": NORMAL 
  85. 12280  PRINT D$;"RUN NIBBLE DINER"